Raport - Analiza bazy danych Lego na przestrzeni lat
Tobiasz Gruszczyński 145333
09 grudzień 2023
1 Executive summary
Raport ma na celu przeanalizowanie oraz interpretacje bazy danych Lego na przestrzeni lat.
Z roku na rok na rynku możemy zauważyć coraz bardziej rozmaite zestawy klocków Lego. Dlatego też analizie poddano elementy związane z zestawami, figurkami oraz poszczególnymi częściami. W raporcie skupiono się na trendach rozwojowych w tej kategorii produktów, badając zmiany w ilości dostępnych tematyk, rozbudowie zestawów, a także w użyciu figurek i różnorodności części.
Analiza danych obejmuje lata 1980-2023 i uwydatnia ewolucję Lego, zarówno pod kątem liczby produktów, jak i ich złożoności. Zbiór danych został uproszczony do obiektów reprezentujących zestawy z klockami (posiadającymi jakieś części).
Zbiór danych został poddany analizie korelacji, dzięki czemu wyróżniono istotne związki pomiędzy różnymi atrybutami, takimi jak rok produkcji, liczba używanych figurek, czy złożoność zestawów. Korelacje te dostarczają głębszego zrozumienia dynamiki rozwoju produktów Lego na przestrzeni lat.
Ostatnim elementem analizy jest sekcja próbująca przewidzieć złożoność zestawów Lego, w tym celu użyto algorytmu uczenia maszynowego Random Forest. Na tej podstawie można wyciągnać wniosek, że największy wpływ na to mają upływający czas oraz ilość figurek.
2 Powtarzalność wyników
Dla zapewnienia powtarzalności wyników przy każdym uruchomieniu raportu dla tych samych danych, ustawiono ziarno dla generatora liczb pseudolosowych.
set.seed(23)3 Wykorzystane biblioteki
Raport został stworzony przy wykorzystaniu następujących bibliotek.
library(dplyr)
library(ggplot2)
library(tidyr)
library(tibble)
library(plotly)
library(gganimate)
library(caret)
library(randomForest)4 Kod odpowiedzialny za wczytanie danych z plików
colors <- read.csv("dataset/colors.csv")
parts_cat <- read.csv("dataset/part_categories.csv")
elements <- read.csv("dataset/elements.csv")
parts <- read.csv("dataset/parts.csv")
inv_parts <- read.csv("dataset/inventory_parts.csv")
figs <- read.csv("dataset/minifigs.csv")
inv_figs <- read.csv("dataset/inventory_minifigs.csv")
themes <- read.csv("dataset/themes.csv")
sets <- read.csv("dataset/sets.csv")
inv_sets <- read.csv("dataset/inventory_sets.csv")
inventories <- read.csv("dataset/inventories.csv")5 Oczyszczenie i przetwarzanie danych
Ta sekcja poświęcona jest przetworzeniu brakujących wartości oraz transformacji wykorzystanych zbiorów danych.
5.1 Zestawy Lego
Pierwsza i bardzo ważna część badanego zbioru danych. Zawierają się w niej informacje o zestawach Lego, takie jak: rok wydania, ilość części w zestawie oraz lata w jakich dany zestaw zadebiutował na rynku.
sets <- sets %>% filter(num_parts > 0)
themes <- setNames(themes, c("theme_id", "theme_name", "parent_id"))
colnames(sets)[colnames(sets) == "name"] <- "set_name"
colnames(sets)[colnames(sets) == "num_parts"] <- "set_num_parts"
colnames(inv_sets)[colnames(inv_sets) == "quantity"] <- "set_qty"
sets_with_themes <- themes %>%
merge(sets, by = "theme_id") %>%
select(-c("theme_id","img_url","parent_id"))5.1.1 Analiza atrybutów
Na wykresach można zaobserwować pewien trend. Wskazuje on na to, że wraz z upływem czasu powstaje coraz więcej zestawów Lego. Dodatkowo są one coraz większe i bardziej rozbudowane, na co wskazuje rosnąca liczba części.
unique_theme_data <- sets_with_themes %>%
group_by(year) %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
summarise(unique_theme = n_distinct(theme_name, na.rm = TRUE))
ggplot(unique_theme_data , aes(x = year, y = unique_theme)) +
geom_line(aes(y = unique_theme, color = "Unikalne tematyki zestawów"), size = 1) +
labs(x = "Rok", y = "Liczba tematyk", colour = "Legenda") +
scale_color_manual(values=c("#fc8d62")) +
theme_bw()
mean_nparts_data <- sets_with_themes %>%
group_by(year) %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
summarise(sets_mean_nparts = mean(set_num_parts, na.rm = TRUE), sets_count = n())
ggplot(mean_nparts_data , aes(x = year, y = sets_mean_nparts)) +
ggtitle("Średnia liczba części w zestawach w latach 1980-2023") +
geom_bar(stat="identity", fill = "#fc8d62") +
labs(x = "Rok", y = "Liczba części") +
theme_bw()
5.1.2 Podsumowanie zbioru
knitr::kable(summary(sets_with_themes), caption = "Podstawowe statystyki - zestawy Lego")| theme_name | set_num | set_name | year | set_num_parts | |
|---|---|---|---|---|---|
| Length:17231 | Length:17231 | Length:17231 | Min. :1949 | Min. : 1.0 | |
| Class :character | Class :character | Class :character | 1st Qu.:1999 | 1st Qu.: 18.0 | |
| Mode :character | Mode :character | Mode :character | Median :2011 | Median : 54.0 | |
| Mean :2006 | Mean : 204.9 | ||||
| 3rd Qu.:2017 | 3rd Qu.: 203.0 | ||||
| Max. :2023 | Max. :11695.0 |
5.2 Figurki Lego
Kolejna część badanego zbioru danych. Możemy znaleźć w niej informacje o figurkach m.in. z czego się składają.
colnames(figs)[colnames(figs) == "name"] <- "fig_name"
colnames(figs)[colnames(figs) == "num_parts"] <- "fig_num_parts"
colnames(inv_figs)[colnames(inv_figs) == "quantity"] <- "fig_qty"
colnames(inventories)[colnames(inventories) == "id"] <- "inventory_id"
inventory_minifigures <- inv_figs %>%
merge(figs, by = "fig_num") %>%
merge(inventories, by = "inventory_id") %>%
merge(sets, by = "set_num") %>%
select(-c(1:2, 7:9, 11:13))5.2.1 Analiza atrybutów
Jeśli chodzi o ilość wykorzystywanych w zestawach figurek to możemy zauważyć, że z czasem pojawiają się coraz częściej.
figures_number <- inventory_minifigures %>%
group_by(year) %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
summarise(fig_count = n())
ggplot(figures_number , aes(x = year, y = fig_count)) +
geom_line(aes(y = fig_count, color = "Liczba figurek"), size = 1) +
labs(x = "Rok", y = "Liczba figurek", colour = "Legenda") +
scale_color_manual(values=c("#fc8d62")) +
theme_bw()
5.2.2 Podsumowanie zbioru
knitr::kable(summary(inventory_minifigures), caption = "Podstawowe statystyki - figurki Lego")| fig_num | fig_qty | fig_name | fig_num_parts | year | |
|---|---|---|---|---|---|
| Length:20817 | Min. : 1.000 | Length:20817 | Min. : 1.000 | Min. :1975 | |
| Class :character | 1st Qu.: 1.000 | Class :character | 1st Qu.: 4.000 | 1st Qu.:2006 | |
| Mode :character | Median : 1.000 | Mode :character | Median : 4.000 | Median :2014 | |
| Mean : 1.062 | Mean : 4.814 | Mean :2011 | |||
| 3rd Qu.: 1.000 | 3rd Qu.: 5.000 | 3rd Qu.:2019 | |||
| Max. :100.000 | Max. :143.000 | Max. :2023 |
5.3 Części Lego
Ostatania część badanego zestawu danych zawiera informacje na temat części Lego. Znajdują się w niej szczegóły poszczególnych części: elementy z których się składają, kolor, materiał z którego zostały wykonane oraz kategoria do której przynależą.
colnames(parts)[colnames(parts) == "name"] <- "part_name"
colnames(parts_cat)[colnames(parts_cat) == "name"] <- "part_cat_name"
colnames(parts_cat)[colnames(parts_cat) == "id"] <- "part_cat_id"
colnames(colors)[colnames(colors) == "name"] <- "color_name"
colnames(colors)[colnames(colors) == "id"] <- "color_id"
colnames(inv_parts)[colnames(inv_parts) == "quantity"] <- "part_qty"
element_counts <- elements %>%
group_by(part_num, color_id) %>%
summarise(el_per_part = n())
inventory_parts <- inv_parts %>%
merge(parts, by = "part_num") %>%
merge(colors, by = "color_id") %>%
merge(parts_cat, by = "part_cat_id") %>%
merge(element_counts, by = c("part_num", "color_id")) %>%
merge(inventories, by = "inventory_id") %>%
merge(sets, by = "set_num") %>%
select(-c(1:2, 4, 7:8, 12, 16:17, 19:21))5.3.1 Analiza atrybutów
W przypadku części Lego również można dostrzec pewne trendy. Wykorzystywane elementy są coraz bardziej zróżnicowane, poprzez tworzenie części z nowych materiałów oraz w nowych kolorach. Warte wyróżnienia jest, że złożoność części się nie zmieniła (na jedną część średnio przypada 1.6 elementu)
transparent_parts <- inventory_parts %>%
group_by(is_trans) %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
summarise(trans_part_count = n())
ggplot(transparent_parts, aes(x=is_trans, y=trans_part_count, fill=is_trans)) +
geom_bar(stat="identity", position="dodge") +
scale_fill_manual(values = c("t" = "#66c2a5", "f" = "#fc8d62"), labels = c("TAK", "NIE")) +
scale_x_discrete(labels = c("t" = "TAK", "f" = "NIE")) +
labs(title = "Zestawienie kolorów (transparentność)", x = "Transparentność", y = "Liczba obserwacji", fill = "Legenda") +
theme_bw()
unique_data <- inventory_parts %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
group_by(year, part_material) %>%
summarise(count = n(), type = "Material") %>%
bind_rows(
inventory_parts %>%
group_by(year, color_name) %>%
summarise(count = n(), type = "Color") %>%
bind_rows(
inventory_parts %>%
group_by(year, part_cat_name) %>%
summarise(count = n(), type = "Category")
)
)
ggplot(unique_data, aes(x = year, y = count, fill = type)) +
geom_bar(stat = "identity", position = "dodge") +
facet_grid(type ~ ., scales = "free_y", labeller = labeller(type = c("Material" = "Materiały", "Color" = "Kolory", "Category" = "Kategorie"))) +
scale_fill_manual(values = c("Category" = "#66c2a5", "Color" = "#fc8d62", "Material" = "#8da0cb"), labels = c("Kategorie", "Kolory", "Materiały")) +
labs(x = "Rok", y = "Liczba obserwacji", fill = "Legenda") +
theme_bw()
elements_count <- inventory_parts %>%
group_by(year) %>%
filter(year >= 1980) %>%
filter(year <= 2023) %>%
summarise(el_in_part = mean(el_per_part, na.rm = TRUE))
ggplot(elements_count , aes(x = year, y = el_in_part)) +
geom_line(aes(color = "Średnia ilość elementów w częściach"), size = 1) +
labs(x = "Rok", y = "Liczba elementów", colour = "Legenda") +
scale_color_manual(values=c("#fc8d62")) +
theme_bw()
5.3.2 Podsumowanie zbioru
knitr::kable(summary(inventory_parts), caption = "Podstawowe statystyki - części Lego")| part_num | part_cat_id | part_qty | part_name | part_material | color_name | is_trans | part_cat_name | el_per_part | year | |
|---|---|---|---|---|---|---|---|---|---|---|
| Length:1040178 | Min. : 1.00 | Min. : 1.000 | Length:1040178 | Length:1040178 | Length:1040178 | Length:1040178 | Length:1040178 | Min. :1.000 | Min. :1954 | |
| Class :character | 1st Qu.:11.00 | 1st Qu.: 1.000 | Class :character | Class :character | Class :character | Class :character | Class :character | 1st Qu.:1.000 | 1st Qu.:2008 | |
| Mode :character | Median :15.00 | Median : 2.000 | Mode :character | Mode :character | Mode :character | Mode :character | Mode :character | Median :1.000 | Median :2016 | |
| Mean :21.73 | Mean : 3.566 | Mean :1.591 | Mean :2013 | |||||||
| 3rd Qu.:28.00 | 3rd Qu.: 4.000 | 3rd Qu.:2.000 | 3rd Qu.:2020 | |||||||
| Max. :68.00 | Max. :3064.000 | Max. :9.000 | Max. :2023 |
5.4 Połączenie danych
dataset <- unique_theme_data %>%
merge(mean_nparts_data) %>%
merge(figures_number) %>%
merge(transparent_parts) %>%
merge(elements_count)6 Podsumowanie badanego zbioru
knitr::kable(summary(dataset))| year | unique_theme | sets_mean_nparts | sets_count | fig_count | is_trans | trans_part_count | el_in_part | |
|---|---|---|---|---|---|---|---|---|
| Min. :1980 | Min. :14.00 | Min. : 66.47 | Min. : 72.0 | Min. : 48.0 | Length:88 | Min. : 61979 | Min. :1.426 | |
| 1st Qu.:1991 | 1st Qu.:23.75 | 1st Qu.:108.15 | 1st Qu.:153.2 | 1st Qu.: 135.2 | Class :character | 1st Qu.: 61979 | 1st Qu.:1.588 | |
| Median :2002 | Median :51.00 | Median :156.56 | Median :341.0 | Median : 289.0 | Mode :character | Median :513332 | Median :1.610 | |
| Mean :2002 | Mean :49.16 | Mean :175.58 | Mean :364.5 | Mean : 467.2 | Mean :513332 | Mean :1.598 | ||
| 3rd Qu.:2012 | 3rd Qu.:69.50 | 3rd Qu.:225.65 | 3rd Qu.:544.0 | 3rd Qu.: 855.5 | 3rd Qu.:964684 | 3rd Qu.:1.638 | ||
| Max. :2023 | Max. :90.00 | Max. :412.85 | Max. :761.0 | Max. :1296.0 | Max. :964684 | Max. :1.662 |
6.1 Trend w rozwoju LEGO
W tej sekcji przedstawiono jak na przestrzeni lat (1980-2023) zmieniały się trendy w Lego. Uwzględniono zmiany w złożoności zestawów (średniej liczby wykorzystywanych w nich części) poprzez wielkość punktu, w porównaniu z ilością wykorzystywanych w zestawach figurek oraz liczby dostępnych zestawów.
Na podstawie wykresu możemy zauważyć, że największy przeskok jeśli chodzi o zaawansowanie zestawów (ich ilość i złożoność), przypada na okres około 2010 roku.
animation <- dataset %>%
select(year, sets_count, fig_count, sets_mean_nparts)
p <- ggplot(animation, aes(x=sets_count, y=fig_count, size = sets_mean_nparts)) +
geom_point(show.legend = FALSE, alpha = 0.8, color = "#fc8d62") +
labs(title = 'Rok: {frame_time}', x = "Liczba dostępnych zestawów", y = "Ilość wykorzystywanych figurek") +
transition_time(year) +
theme_bw()
animate(p, nframes = 225)
7 Wyznaczenie korelacji
Na poniższym wykresie przedstawiona została wartość współczynnika korelacji Pearsona między parametrami atrybutów w zbiorze.
W tabeli przedstawiono wartości współczynnika korelacji dla poszczególnych par atrybutów.
| Wiersz | Kolumna | Współczynnik korelacji |
|---|---|---|
| unique_theme | year | 0.9546391 |
| sets_count | unique_theme | 0.9500207 |
| fig_count | sets_count | 0.9461115 |
| sets_count | year | 0.9394910 |
| fig_count | year | 0.9279022 |
| fig_count | unique_theme | 0.9105042 |
| sets_mean_nparts | year | 0.8495637 |
| fig_count | sets_mean_nparts | 0.8277278 |
| sets_count | sets_mean_nparts | 0.7334811 |
| sets_mean_nparts | unique_theme | 0.7245879 |
| el_in_part | unique_theme | 0.3022160 |
| el_in_part | year | 0.2540180 |
| el_in_part | sets_count | 0.1396989 |
| el_in_part | sets_mean_nparts | -0.0813053 |
| el_in_part | fig_count | 0.0291011 |
| sets_mean_nparts | trans_part_count | 0.0000000 |
| sets_count | trans_part_count | 0.0000000 |
| fig_count | trans_part_count | 0.0000000 |
| trans_part_count | year | 0.0000000 |
| trans_part_count | unique_theme | 0.0000000 |
| el_in_part | trans_part_count | 0.0000000 |
7.1 Podsumowanie
Wnioski wyciągnięte na podstawie obliczeń współczynnika korelacji:
- Rok i unikalne tematyki: wraz z upływem czasu na rynku pojawiają się zestawy o nowych tematykach
- Rok i liczba figurek: wraz z upływem czasu w zestawach znajduje się więcej figurek
- Rok i średnia liczba części w zestawach: wraz z upływem czasu zestawy stają się coraz bardziej rozbudowane i są większe (więcej części)
- Liczba elementów w częściach i unikalne tematyki: poszczególne tematyki zestawów różnią się pod względem złożoności części w zestawach
- Liczba elementów w częściach i średnia liczba części w zestawach: w bardziej rozbudowanych zestawach wykorzystywane klocki są mniej złożone
- Liczba transparentnych kolorów elementów: brak wykazanej korelacji. Może to sugerować, że to czy element jest przezroczysty, nie jest istotnym aspektem zestawów klocków
8 Klasyfikacja
W tej sekcji opisano wykorzystanie uczenia maszynowego do prognozowania złożoności zestawów Lego, czyli średniej liczby ich części. Do tego celu użyto algorytmu Random Forest, z zastosowaniem metody losowania ze zwracaniem (bootstraping).
8.1 Podział zbioru danych
dataset$is_trans <- as.factor(dataset$is_trans)
inTraining <-
createDataPartition(
y = dataset$sets_mean_nparts,
p = .7,
list = FALSE)
training <- dataset[inTraining,]
testing <- dataset[-inTraining,]8.2 Schemat uczenia
Przygotowano schemat uczenia wraz z optymalizacją parametrów modelu. Najlepszy model został stworzony dla parametru liczby zmiennych losowo wybranych jako kandydaci w każdym podziale (mtry) równego 7. Poza tym wybrany model charakteryzuje się najniższym błędem średniokwadratowym (RMSE), który wynosi 24.44512. Dodatkowo miara dopasowania modelu do danych (Rsquared) również jest też najwyższa.
rfGrid <- expand.grid(mtry = 2:20)
gridCtrl <- trainControl(method = "boot", number = 100)8.3 Uczenie modelu
fitTune <- train(sets_mean_nparts ~ .,
data = training,
method = "rf",
trControl = gridCtrl,
tuneGrid = rfGrid,
ntree = 40)
fitTune## Random Forest
##
## 64 samples
## 7 predictor
##
## No pre-processing
## Resampling: Bootstrapped (100 reps)
## Summary of sample sizes: 64, 64, 64, 64, 64, 64, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 2 29.16485 0.8988941 22.91078
## 3 26.00530 0.9139084 19.79199
## 4 24.67108 0.9235214 18.79547
## 5 25.12532 0.9208001 19.13988
## 6 25.06607 0.9209305 19.02791
## 7 24.44512 0.9240855 18.59438
## 8 24.59383 0.9230282 18.63861
## 9 24.73483 0.9220767 18.75369
## 10 24.83435 0.9209057 18.85592
## 11 25.16977 0.9191875 19.00527
## 12 24.75590 0.9220630 18.89430
## 13 25.00818 0.9205321 18.96919
## 14 24.91438 0.9210614 18.92374
## 15 24.93358 0.9207246 18.82868
## 16 25.00278 0.9212167 18.93892
## 17 24.69690 0.9220072 18.73967
## 18 24.70791 0.9220882 18.68116
## 19 24.72770 0.9228712 18.73315
## 20 25.01388 0.9213432 18.97987
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 7.8.4 Predykcja
predictions <- predict(fitTune, newdata = testing)8.5 Ważność atrybutów
important_df <- data.frame(importance(fitTune$finalModel))
important_df$names <- rownames(important_df)
ggplot(important_df, aes(x=names, y=IncNodePurity/1000)) +
geom_bar(stat="identity", fill = "#fc8d62") +
labs(title = "Wykres ważności atrybutów w podejmowaniu decyzji", x="Atrybuty", y="Ważność") +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust=1))
Na podstawie powyższego wykresu okazuje się, że najważniejszymi atrybutami są:
- Rok: Wraz z upływem czasu powstające zestawy Lego są coraz bardziej rozbudowane.
- Liczba figurek: Poziom rozbudowania zestawu wpływa również na liczbę figurek, które się w nim znajdują.
8.6 Zestawienie przewidywań modelu z rzeczywistymi wartościami
compare_df <- testing %>% select(year, sets_mean_nparts)
compare_df$Predict <- predictions
ggplot(compare_df, aes(x = year)) +
geom_line(aes(y = sets_mean_nparts, color = "Rzeczywista liczba części"), size = 1) +
geom_line(aes(y = Predict, color = "Przewidywana liczba części"), size = 1) +
labs(x = "Rok", y = "Średnia liczba części w zestawie") +
scale_color_manual(name = "Legenda", values = c("Rzeczywista liczba części" = "#fc8d62", "Przewidywana liczba części" = "#8da0cb")) +
theme_bw()